home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / examples.zoo / misc / human.lsp < prev    next >
Lisp/Scheme  |  1991-10-22  |  2KB  |  44 lines
  1. ; Beispiele zum objektorientierten Programmieren:
  2.  
  3. (setq *print-circle* t)
  4.  
  5. ; (defns fun funktionalesObjekt)
  6. ; definiert die Funktion fun so, daß sie eine noeval,spread-Funktion ist:
  7. ; die Argumente werden 1. nicht ausgewertet, 2. mit der Lambda-Liste gematcht,
  8. ; 3. der Body ausgewertet und 4. normal zurückgegeben.
  9. ; Übersetzung: (fun x1 ... xk) -> (funcall funobj x1 ... xk)
  10. ; also (defmacro fun (&rest x) (list* 'funcall funobj x))
  11. (defun defns (funname funobj)
  12.   (eval `(defmacro ,funname (&rest x)
  13.            (list* 'funcall '',funobj (mapcar #'(lambda (y) `',y) x)))))
  14.  
  15. ; Ein "Mensch" sei eine Funktion, die Kommandos wie WIEHEISSTDU, LERNE, RECHNE,
  16. ; ISS, WIEGDICH, GEBAERE versteht.
  17.  
  18. (labels ((mensch (&key name (wissen 0.0) (gewicht 5)
  19.                   &aux (kinder nil))
  20.            #'(lambda (kommando &rest args)
  21.                (case kommando
  22.                  (WIEHEISSTDU name)
  23.                  (LERNE (setq wissen (/ (- 2 wissen))) 'OK)
  24.                  (RECHNE (dolist (expr args)
  25.                            (format t "~%~S  =  ~S" expr (* wissen (eval expr)))
  26.                          ) 'OK)
  27.                  (ISS (setq gewicht (+ gewicht 1)) 'OK)
  28.                  (WIEGDICH gewicht)
  29.                  (GEBAERE (let ((kind (first args)))
  30.                             (cond ((member kind kinder)
  31.                                    (format t
  32.                                     "~%Ein Kind mit Namen ~S habe ich schon."
  33.                                     kind))
  34.                                   (t (defns kind
  35.                                            (mensch :name kind :wissen wissen))
  36.                                      (push kind kinder)
  37.                                      kind
  38.                  )        ) )     )
  39.              ) )
  40.         ))
  41.   (defns 'adam (mensch :name 'adam :wissen 0 :gewicht 10))
  42. )
  43.  
  44.